home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD59615212000.psc / Mixed API Demo / modBitmapInMenu.bas < prev    next >
Encoding:
BASIC Source File  |  2000-05-19  |  3.0 KB  |  92 lines
  1. Attribute VB_Name = "modBitmapInMenu"
  2. '/\/\/\/\/\/\/\ BITMAPS IN MENU RE-USABLE MODULE /\/\/\/\/\
  3. 'Code by Andy McCurtin
  4. 'Do what you want with it
  5. 'And ENJOY!!!!
  6. 'Any probs e-mail
  7. 'andy_mccurtin@yahoo.com
  8.  
  9. Option Explicit
  10.  
  11. '//This call accepts 1 argument, the window handle(hwnd)
  12. '//e.g. Me.hwnd. It uses the windows handle to find a
  13. '//'collection' of menu's from that form.
  14. '//It returns a number if it finds any and a 0 if it doesn't
  15. Public Declare Function GetMenu Lib "user32" (ByVal _
  16. hwnd As Long) As Long
  17.  
  18. '//This accepts 2 arguments, the menu collection handle
  19. '//(from above) and nPos this specifies the number of the
  20. '//menu you are refering to (This always begins with 0)
  21. Public Declare Function GetSubMenu Lib "user32" (ByVal _
  22. hMenu As Long, ByVal nPos As Long) As Long
  23.  
  24. '//This accepts 2 arguments, the Sub Menu Id(from above)
  25. '//and again nPos
  26. Public Declare Function GetMenuItemID Lib "user32" (ByVal _
  27. hMenu As Long, ByVal nPos As Long) As Long
  28.  
  29. '//This does the hard work, using info from the above 3 calls
  30. '//With the above calls we now have a pointer to the menu
  31. '// item that we want to add a picture to.  This function
  32. '//returns a 1 if everything works
  33. Public Declare Function SetMenuItemBitmaps Lib "user32" _
  34. (ByVal hMenu As Long, ByVal nPosition As Long, ByVal _
  35. wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal _
  36. hBitmapChecked As Long) As Long
  37.  
  38.  
  39.  
  40.  
  41. '//This function can easily be copied into a form
  42. '//change frm for the forms name
  43. '//Although the picture boxes have to be named you could
  44. '//alter this using an array and run through the array
  45. '//adding them to the menu
  46. Public Function BitmapInMenu(frm As Form)
  47. '//Variables
  48. Dim Menu As Long
  49. Dim SubMenu As Long
  50. Dim MenuItemID As Long
  51. Dim MenuItemID1 As Long
  52. Dim Test As Long
  53.  
  54. '//Get the Menu collection ID for this form
  55. Menu = GetMenu(frm.hwnd)
  56.  
  57. '//Get Sub Menu ID using value from above
  58. SubMenu = GetSubMenu(Menu, 0)
  59.  
  60. '//Takes the SubMenuID from above and the position of the
  61. '//menu item i.e. 0 is <<< Here it is, 1 is seperator,
  62. '//2 is Exit etc
  63. MenuItemID = GetMenuItemID(SubMenu, 0) 'mnuHere
  64.  
  65. MenuItemID1 = GetMenuItemID(SubMenu, 2) 'mnuExit
  66.  
  67. '//Takes picture from picTest and puts it in the menu next to
  68. '//<<< Here it is
  69. Test = SetMenuItemBitmaps(Menu, MenuItemID, 0, frm!picTest.Picture _
  70.                 , frm!picTest.Picture)
  71.  
  72. '//Takes picture from picExit and puts it in the menu next to
  73. '//Exit
  74. Test = SetMenuItemBitmaps(Menu, MenuItemID1, 0, frm!picExit.Picture _
  75.                 , frm!picExit.Picture)
  76.  
  77.  
  78. '/////This code puts bitmaps in the sub menus
  79. '//Get ID of Second Menu  (SubMenu)
  80. SubMenu = GetSubMenu(Menu, 1)
  81. '//Get ID of SubClass Sub Menu (Dummy)
  82. SubMenu = GetSubMenu(SubMenu, 0)
  83.  
  84.     MenuItemID1 = GetMenuItemID(SubMenu, 0) 'Cool
  85.  
  86. '//Takes picture from picExit and puts it in the menu next to
  87. '//Exit
  88. Test = SetMenuItemBitmaps(SubMenu, MenuItemID1, 1, frm!picTest.Picture _
  89.                 , frm!picTest.Picture)
  90.  
  91. End Function
  92.